home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / datetime / datetim1.frm next >
Text File  |  1995-09-06  |  11KB  |  364 lines
  1. VERSION 2.00
  2. Begin Form FullWindow 
  3.    BackColor       =   &H00000000&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "DateTime"
  6.    ClientHeight    =   210
  7.    ClientLeft      =   360
  8.    ClientTop       =   630
  9.    ClientWidth     =   2880
  10.    ForeColor       =   &H00FFFFFF&
  11.    Height          =   900
  12.    Icon            =   DATETIM1.FRX:0000
  13.    Left            =   300
  14.    LinkMode        =   1  'Source
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    ScaleHeight     =   210
  18.    ScaleWidth      =   2880
  19.    Top             =   0
  20.    Width           =   3000
  21.    Begin Timer Zeitmesser 
  22.       Index           =   1
  23.       Interval        =   1000
  24.       Left            =   0
  25.       Top             =   0
  26.    End
  27.    Begin Menu Menu 
  28.       Caption         =   "&Menu"
  29.       Begin Menu MenuClick 
  30.          Caption         =   "&Click"
  31.       End
  32.       Begin Menu Separator1 
  33.          Caption         =   "-"
  34.       End
  35.       Begin Menu MenuFormat 
  36.          Caption         =   "dddd ddddd ttttt"
  37.          Checked         =   -1  'True
  38.          Index           =   1
  39.       End
  40.       Begin Menu MenuFormat 
  41.          Caption         =   "dddd ddddd hh:mm"
  42.          Index           =   2
  43.       End
  44.       Begin Menu MenuFormat 
  45.          Caption         =   "ddd ddddd hh:mm"
  46.          Index           =   3
  47.       End
  48.       Begin Menu MenuFormat 
  49.          Caption         =   "dddd d-mmmm-yy h:mm:ss"
  50.          Index           =   4
  51.       End
  52.       Begin Menu MenuFormat 
  53.          Caption         =   "ddd dd-mmm-yy hh:mm"
  54.          Index           =   5
  55.       End
  56.       Begin Menu MenuFormat 
  57.          Caption         =   "ddd d/m/yy h:mm"
  58.          Index           =   6
  59.       End
  60.       Begin Menu MenuFormat 
  61.          Caption         =   "Enter your own format"
  62.          Index           =   7
  63.       End
  64.       Begin Menu Separator2 
  65.          Caption         =   "-"
  66.       End
  67.       Begin Menu MenuAbout 
  68.          Caption         =   "&About..."
  69.       End
  70.    End
  71.    Begin Menu MenuHelp 
  72.       Caption         =   "&Help"
  73.    End
  74. End
  75. ' Program related declarations
  76. Const INIFILENAME$ = "DATETIME.INI"
  77. Dim HelpFilePath$, DTFormat$
  78.  
  79. Sub Clear_MenuFormat_Checkmarks ()
  80.     For i% = 1 To 7
  81.         MenuFormat(i%).Checked = False
  82.     Next i%
  83. End Sub
  84.  
  85. Sub Form_Load ()
  86.     Initialize
  87.  
  88.     ' Get parameters from file (INIFILENAME$):
  89.  
  90.     Left = GetPrivateProfileInt("DateTime", "Left", 300, INIFILENAME$)
  91.     Top = GetPrivateProfileInt("DateTime", "Top", 0, INIFILENAME$)
  92.     x$ = Space$(256)
  93.     i% = GetPrivateProfileString("DateTime", "Click", "no", x$, 255, INIFILENAME$)
  94.     x$ = Left$(x$, i%) ' Remove trailing Chr$(0) and other stuff
  95.     x$ = LTrim$(RTrim$(x$)) ' Remove leading and trailing blanks
  96.     x$ = UCase$(x$)
  97.     MenuClick.Checked = x$ = "YES" Or x$ = "TRUE" Or x$ = "ON" Or x$ = "1"
  98.     x$ = Space$(256)
  99.     i% = GetPrivateProfileString("DateTime", "FormatString", "Enter your own format", x$, 255, INIFILENAME$)
  100.     x$ = Left$(x$, i%) ' Remove trailing Chr$(0) and other stuff
  101.     x$ = LTrim$(RTrim$(x$)) ' Remove leading and trailing blanks
  102.     MenuFormat(7).Caption = x$
  103.     i% = GetPrivateProfileInt("DateTime", "FormatNumber", 1, INIFILENAME$)
  104.     Clear_MenuFormat_Checkmarks
  105.     
  106.     ' Determine DTFormat$ and put check mark next to active format:
  107.  
  108.     DTFormat$ = MenuFormat(i%).Caption
  109.     MenuFormat(i%).Checked = True
  110.     
  111.     ' Determine own path to find help file later.
  112.     ' First get own path and file name:
  113.  
  114.     HelpFilePath$ = Space$(128)
  115.     hModule% = GetClassWord(hWnd, GCW_HMODULE)
  116.     i% = GetModuleFileName(hModule%, HelpFilePath$, 127)
  117.     HelpFilePath$ = Left$(HelpFilePath$, i%) ' Remove chr$(0) and other stuff
  118.  
  119.     ' Remove extension and replace with .WRI:
  120.  
  121.     Do While Right$(HelpFilePath$, 1) <> "." And Len(HelpFilePath$)
  122.         HelpFilePath$ = Left$(HelpFilePath$, Len(HelpFilePath$) - 1)
  123.     Loop
  124.     HelpFilePath$ = HelpFilePath$ + "WRI"
  125.  
  126.     ' Initialize display string:
  127.  
  128.     DatTim$ = "Initializing, one moment please..."
  129.     Load SmallWindow
  130.     
  131.     ' Load start timer which runs for one second only, then forces
  132.     ' WindowState from MINIMIZED to NORMAL to facilitate loading
  133.     ' from the WIN.INI load= line:
  134.     
  135.     Load Zeitmesser(2)
  136.     Zeitmesser(2).Interval = 1000
  137. End Sub
  138.  
  139. Sub Form_Paint ()
  140.  
  141.     ' DatTim$ is a global variable containing the text to be displayed:
  142.  
  143.     Cls: Print DatTim$;
  144.     If CurrentX Then
  145.         If CurrentX > 2000 Then
  146.             Width = CurrentX + 32
  147.         Else
  148.             Width = 2000
  149.         End If
  150.         SmallWindow.Width = CurrentX
  151.     End If
  152.     
  153.     ' SmallWindow shall always follow FullWindow but is hidden
  154.     ' as long FullWindow is active:
  155.  
  156.     SmallWindow.Left = Left
  157.     SmallWindow.Top = Top
  158. End Sub
  159.  
  160. Sub Form_Resize ()
  161.     If WindowState <> MINIMIZED Then
  162.  
  163.         ' Zeitmesser(1) timer when resized from icon to normal:
  164.  
  165.         If Zeitmesser(1).Interval = 0 Then Zeitmesser(1).Interval = 1000
  166.     Else ' WindowState = MINIMIZED, i.e. an icon
  167.  
  168.         ' If resized to icon then stop timer to reduce system load,
  169.         ' hide the small form and clear text so it does not display
  170.         ' over the icon:
  171.  
  172.         Zeitmesser(1).Interval = 0
  173.         SmallWindow.Hide
  174.         SmallWindow.Cls
  175.         Cls
  176.     End If ' WindowState
  177.  
  178.     ' Let the small form always follow the primary one:
  179.  
  180.     SmallWindow.WindowState = WindowState
  181. End Sub
  182.  
  183. Sub Form_Unload (Abbrechen%)
  184.     
  185.     ' To make sure the parameters of the NORMAL window are saved,
  186.     ' not the ones of the icon in case the form is minimized:
  187.  
  188.     WindowState = NORMAL
  189.  
  190.     ' Write all parameters into DATETIME.INI:
  191.  
  192.     i% = WritePrivateProfileString("DateTime", "Left", Str$(Left), INIFILENAME$)
  193.     i% = WritePrivateProfileString("DateTime", "Top", Str$(Top), INIFILENAME$)
  194.     If MenuClick.Checked Then x$ = "yes" Else x$ = "no"
  195.     i% = WritePrivateProfileString("DateTime", "Click", x$, INIFILENAME$)
  196.     x$ = MenuFormat(7).Caption
  197.     i% = WritePrivateProfileString("DateTime", "FormatString", x$, INIFILENAME$)
  198.     For i% = 1 To 7
  199.         If MenuFormat(i%).Checked Then
  200.             i% = WritePrivateProfileString("DateTime", "FormatNumber", Str$(i%), INIFILENAME$)
  201.             Exit For
  202.         End If
  203.     Next i%
  204.  
  205.     ' Make sure the other form is unloaded also:
  206.  
  207.     End
  208. End Sub
  209.  
  210. Sub Initialize ()
  211.     
  212.     ' Set general constants that cannot be declared:
  213.  
  214.     NL$ = Chr$(13) + Chr$(10)
  215.     TB$ = Chr$(9)
  216.     
  217. End Sub
  218.  
  219. Sub MenuAbout_Click ()
  220.     Form_Paint
  221.     MsgBox TB$ + "  DateTime" + NL$ + "            Copyright ⌐ 1991" + NL$ + "    A.C.I. GmbH MicroSysteme" + NL$ + "          Hans-Georg Michna" + NL$ + "74776.2361@compuserve.com" + NL$ + "      Select Help for more info."
  222. End Sub
  223.  
  224. Sub MenuClick_Click ()
  225.     MenuClick.Checked = Not MenuClick.Checked
  226. End Sub
  227.  
  228. Sub MenuFormat_Click (Index%)
  229.     If Index% = 7 Then
  230.  
  231.         ' Make sure that the window is repainted
  232.         ' which may have been obscured by the unfolding menu:
  233.     
  234.         Refresh
  235.  
  236.         ' Ask user for its own format string:
  237.  
  238.         x$ = "Date and time codes:" + NL$
  239.         x$ = x$ + "Day:" + TB$ + "d..dddd" + NL$
  240.         x$ = x$ + "Month:" + TB$ + "m..mmmm" + NL$
  241.         x$ = x$ + "Year:" + TB$ + "yy or yyyy" + NL$
  242.         x$ = x$ + "Full date: ddddd" + NL$
  243.         x$ = x$ + "Hour:" + TB$ + "h or hh" + NL$
  244.         x$ = x$ + "Minute:" + TB$ + "m or mm" + NL$
  245.         x$ = x$ + "Second: s or ss" + NL$
  246.         x$ = x$ + "Full time: ttttt" + NL$
  247.         x$ = x$ + "Date delimiter: /" + NL$
  248.         x$ = x$ + "Example: d/m/yy h:mm"
  249.         y$ = MenuFormat(7).Caption
  250.         x$ = InputBox$(x$, "Enter Your Own Format", MenuFormat(7).Caption)
  251.         If x$ = "" Then
  252.             MenuFormat(7).Caption = y$
  253.             Exit Sub
  254.         Else
  255.             MenuFormat(7).Caption = x$
  256.         End If
  257.     
  258.         ' Now try if this string really works:
  259.  
  260.         Err = 0
  261.         On Error Resume Next
  262.         x$ = Format$(Now, MenuFormat(7).Caption)
  263.         ErrNo% = Err
  264.